home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.001 / GOLDLINK.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-12  |  57KB  |  2,055 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit                       }
  3. {                Version: GOLD                                             }
  4. {                Build:   1.01                                             }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11.                      {********************************}
  12.                      {       Unit:   GOLDLINK         }
  13.                      {********************************}
  14.  
  15. {++++++++++++++++++++++++++++++} unit GOLDLINK; {++++++++++++++++++++++++++++}
  16.  
  17. {$I GOLDFLAG.INC}
  18. {$IFNDEF GOLDLINK}
  19.    {$DEFINE GOLDLINK}
  20. {$ENDIF}
  21.  
  22. {++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}
  23.  
  24. uses DOS, CRT, GoldStr, GoldMisc, GoldHard;
  25.  
  26. const
  27.    GCompleteString = 255;
  28.    TagBit = 0;
  29.    ColBit = 1;
  30.  
  31. type
  32.    {String singly-linked list}
  33.    StrItemPtr = ^StrItem;
  34.    StrItem = record
  35.       NextPtr: StrItemPtr;
  36.       Bits: byte;
  37.       StrPtr: ^string;
  38.    end; {StrItem}
  39.  
  40.    StringLLPtr = ^StringLL;
  41.    StringLL = record
  42.       TotalNodes: integer;
  43.       ActiveNode: integer;
  44.       TopNode: integer;
  45.       StartNodePtr: StrItemPtr;
  46.    end; {StringLL}
  47.  
  48.    {Single Linked List structures}
  49.    SingleNodePtr = ^SingleNodeRec;
  50.    SingleNodeRec = record
  51.       NextPtr: SingleNodePtr;
  52.       Bits: byte;
  53.       DataPtr: pointer;
  54.       DataSize: longint;
  55.    end; {SingleNodeRec}
  56.  
  57.    SingleLLPtr = ^SingleLL;
  58.    SingleLL = record
  59.       StartNodePtr: SingleNodePtr;
  60.       EndNodePtr: SingleNodePtr;
  61.       TotalNodes: longint;
  62.       StrVars: boolean;          {is data stored at node a string?}
  63.       Dirty: boolean;
  64.    end; {SingleLL}
  65.  
  66.    {Double Linked List structures}
  67.    DoubleNodePtr = ^DoubleNodeRec;
  68.    DoubleNodeRec = record
  69.       NextPtr: DoubleNodePtr;
  70.       PrevPtr: DoubleNodePtr;
  71.       DataPtr: pointer;
  72.       DataSize: longint;
  73.       Bits: byte;
  74.    end; {DoubleNodeRec}
  75.  
  76.    DLLWrongOrderFunc = function(SortID:shortint;Node1,Node2:DoubleNodePtr;Asc:boolean): boolean;
  77.    DLLGetStrFunc = function(Node:DoubleNodePtr;Start,Finish: longint): string;
  78.  
  79.    DoubleLLPtr = ^DoubleLL;
  80.    DoubleLL = record
  81.       StartNodePtr: DoubleNodePtr;
  82.       EndNodePtr: DoubleNodePtr;
  83.       ActiveNodePtr: DoubleNodePtr;
  84.       TotalNodes: longint;
  85.       ActiveNodeNumber: longint;
  86.       SortID: shortInt;
  87.       SortAscending: boolean;
  88.       StrVars: boolean;          {is data stored at node a string?}
  89.       Dirty: boolean;
  90.       WrongOrder: DLLWrongOrderFunc;
  91.       GetStr: DLLGetStrFunc;
  92.    end; {DoubleLL}
  93.  
  94.    LinkSet = record
  95.       LastEcode: integer;
  96.       LastActiveDLL,
  97.       ActiveDLL: DoubleLLPtr;
  98.       LastActiveSLL,
  99.       ActiveSLL: SingleLLPtr;
  100.       NoFilesFound:string[12];
  101.       NoDirectories:string[12];
  102.    end; {linkset}
  103.  
  104. function  LastLinkError: integer;
  105. {Simple String Linked Lists}
  106. procedure StrLLInit(var SL:StringLL);
  107. function  StrLLNodePtr(var SL:StringLL; Num:integer): StrItemPtr;
  108. function  StrLLAdd(var SL:StringLL; Str:String): integer;
  109. function  StrLLGetStr(var SL:StringLL;Num:integer): string;
  110. procedure StrLLDestroy(var SL:StringLL);
  111. function  SLGetStr(P:pointer;Element,Start,Finish: longint): string;
  112. function  LoadWithDirectories(var SL:StringLL;ParentDir:string): integer;
  113. function  LoadWithDrives(var SL:StringLL): integer;
  114. function  LoadFileMasks(var SL:StringLL;MaskStr:string): integer;
  115. function  LoadAvailFileExtensions(var SL:StringLL;ParentDir:string): integer;
  116. function  LoadWithFiles(var SL:StringLL;Dir,Filemask:string;Attrib:word): integer;
  117. {Important Procs!}
  118. procedure SLLSetActiveList(var S:SingleLL);
  119. procedure SLLActivatePrevList;
  120. procedure DLLSetActiveList(var D:DoubleLL);
  121. procedure DLLActivatePrevList;
  122. {SLL Procs}
  123. procedure InitSLL(var TheList:SingleLL);
  124. function  SLLNodePtr(NodeNumber:longint): SingleNodePtr;
  125. function  SLLAdd(var TheData;Size:longint): integer;
  126. function  SLLChange(Node:SingleNodePtr;var TheData;Size:longint): integer;
  127. function  SLLInsertBefore(Node:SingleNodePtr;var TheData;Size:longint): integer;
  128. procedure SLLDelNode(Node:SingleNodePtr);
  129. procedure SLLGetNodeData(Node:SingleNodePtr;Var TheData);
  130. function  SLLGetNodeDataSize(Node:SingleNodePtr):longint;
  131. function  SLLGetTagState(Num:longint):boolean;
  132. procedure SLLSetBit(Node:SingleNodePtr; BitPos:byte; On:boolean);
  133. function  SLLGetBit(Node:SingleNodePtr; BitPos:byte): boolean;
  134. procedure SLLDelAllStatus(BitPos:byte;On:boolean);
  135. procedure SLLDestroy;
  136. procedure SLLEmptyList;
  137. {SLL custom string function}
  138. procedure InitSLLStr(var TheList:SingleLL);
  139. function  SLLAddStr(Str:string):integer;
  140. function  SLLChangeStr(Node:SingleNodePtr;Str:string): integer;
  141. function  SLLGetStr(Num:longint):string;
  142. function  SLLGetNodeStr(Node:SingleNodePtr; Len:byte): string;
  143. function  SLLInsStrBefore(Node:SingleNodePtr;Str:string): integer;
  144. {SLL custom file functions}
  145. function  SLLLoadFromFile(Filename:string):integer;
  146. function  SLLSaveToFile(Filename:string):integer;
  147. {DLL Procs}
  148. procedure DLLAssignWrongOrderFunc(Func:DLLWrongOrderFunc);
  149. function  DLLDefWrongOrder(SortID:shortint;Node1,Node2:DoubleNodePtr;Asc:boolean): boolean;
  150. procedure DLLAssignGetStrFunc(Func:DLLGetStrFunc);
  151. function  DLLDefGetStr(Node:DoubleNodePtr;Start,Finish: longint): string;
  152. procedure InitDLL(var TheList:DoubleLL);
  153. procedure InitDLLStr(var TheList:DoubleLL);
  154. procedure DLLFreeNodeData(Node:DoubleNodePtr);
  155. function  DLLNodePtr(NodeNumber:longint): DoubleNodePtr;
  156. function  DLLAdd(var TheData;Size:longint): integer;
  157. function  DLLAddStr(Str:string):integer;
  158. function  DLLChange(Node:DoubleNodePtr;var TheData;Size:longint): integer;
  159. function  DLLInsertBefore(Node:DoubleNodePtr;var TheData;Size:longint): integer;
  160. procedure DLLDelNode(Node:DoubleNodePtr);
  161. procedure DLLGetNodeData(Node:DoubleNodePtr;Var TheData);
  162. function  DLLGetNodeDataSize(Node:DoubleNodePtr):longint;
  163. procedure DLLSwapNodes(Node1,Node2:DoubleNodePtr);
  164. procedure DLLDelAllStatus(BitPos:byte;On:boolean);
  165. procedure DLLAdvance(Amount:longint);
  166. procedure DLLRetreat(Amount:longint);
  167. procedure DLLJump(NodeNumber:longint);
  168. procedure DLLShiftActiveNode(NewNode: DoubleNodePtr; NodeNumber: longint);
  169. procedure DLLSort(SortID:shortint; Ascending:boolean);
  170. function  DLLGetNodeStr(Node:DoubleNodePtr;Start,Finish: longint): string;
  171. function  DLLGetStr(Num:longint): string;
  172. function  DLLGetTagState(Num:longint):boolean;
  173. procedure DLLSetBit(Node:DoubleNodePtr; BitPos:byte; On:boolean);
  174. function  DLLGetBit(Node:DoubleNodePtr; BitPos:byte): boolean;
  175. procedure DLLDestroy;
  176. procedure DLLEmptyList;
  177. function  DLLLoadFromFile(Filename:string):integer;
  178. function  DLLSaveToFile(Filename:string):integer;
  179. {internal}
  180. function  StrLLWidestLine(var SL:StringLL): byte;
  181. function  _SLLNodePtr(var TheList:SingleLL;NodeNumber:longint): SingleNodePtr;
  182. function  _SLLAdd(var TheList:SingleLL;var TheData;Size:longint): integer;
  183. function  _SLLChange(var TheList:SingleLL;Node:SingleNodePtr;var TheData;Size:longint): integer;
  184. function  _SLLInsertBefore(var TheList:SingleLL;Node:SingleNodePtr;var TheData;Size:longint): integer;
  185. procedure _SLLDelNode(var TheList:SingleLL;Node:SingleNodePtr);
  186. function  _SLLGetTagState(var TheList:SingleLL;Num:longint):boolean;
  187. procedure _SLLSetBit(var TheList:SingleLL;Node:SingleNodePtr; BitPos:byte; On:boolean);
  188. procedure _SLLDelAllStatus(var TheList:SingleLL;BitPos:byte;On:boolean);
  189. procedure _SLLDestroy(var TheList:SingleLL);
  190. function  _SLLAddStr(var TheList:SingleLL;Str:string):integer;
  191. function  _SLLChangeStr(var TheList:SingleLL;Node:SingleNodePtr;Str:string): integer;
  192. function  _SLLGetStr(var TheList:SingleLL;Num:longint):string;
  193. function  _SLLGetNodeStr(var TheList:SingleLL;Node:SingleNodePtr; Len:byte): string;
  194. function  _SLLInsStrBefore(var TheList:SingleLL;Node:SingleNodePtr;Str:string): integer;
  195. function  _SLLLoadFromFile(var TheList:SingleLL;Filename:string):integer;
  196.  
  197. var
  198.    LinkVars: LinkSet;
  199. {+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}
  200.  
  201.                      {**********************************}
  202.                      {**    Miscellaneous Routines    **}
  203.                      {**********************************}
  204.  
  205. function LastLinkError: integer;
  206. {}
  207. begin
  208.    LastLinkError := LinkVars.LastEcode;
  209. end; { LastLinkError }
  210.  
  211. procedure SLLSetActiveList(var S:SingleLL);
  212. {}
  213. begin
  214.    with LinkVars do
  215.    begin
  216.       LastActiveSLL := ActiveSLL;
  217.       ActiveSLL := @S;
  218.    end;
  219. end; {SLLSetActiveList}
  220.  
  221. procedure SLLActivatePrevList;
  222. {}
  223. begin
  224.    with LinkVars do
  225.    begin
  226.       ActiveSLL := LastActiveSLL;
  227.       LastActiveSLL := nil;
  228.    end;
  229. end; { SLLActivatePrevList }
  230.  
  231. procedure DLLSetActiveList(var D:DoubleLL);
  232. {}
  233. begin
  234.    with LinkVars do
  235.    begin
  236.       LastActiveDLL := ActiveDLL;
  237.       ActiveDLL := @D;
  238.    end;
  239. end; {DLLSetActiveList}
  240.  
  241. procedure DLLActivatePrevList;
  242. {}
  243. begin
  244.    with LinkVars do
  245.    begin
  246.       ActiveDLL := LastActiveDLL;
  247.       LastActiveDLL := nil;
  248.    end;
  249. end; { DLLActivatePrevList }
  250.  
  251.                      {***********************************}
  252.                      {**  Simple String List Routines  **}
  253.                      {***********************************}
  254.  
  255. function StrLLNodePtr(var SL:StringLL; Num:integer): StrItemPtr;
  256. {}
  257. var
  258.    Counter: integer;
  259.    SIP: StrItemPtr;
  260. begin
  261.    if Num < 1 then
  262.       StrLLNodePtr := nil
  263.    else
  264.    begin
  265.       SIP := SL.StartNodePtr;
  266.       Counter := 0;
  267.       repeat
  268.          inc(Counter);
  269.          if Counter <> Num then
  270.             SIP := SIP^.NextPtr;
  271.       until (Counter = Num) or (SIP = nil);
  272.       StrLLNodePtr := SIP;
  273.    end;
  274. end; { StrLLNodePtr }
  275.  
  276. procedure StrLLInit(var SL:StringLL);
  277. {}
  278. begin
  279.    with SL do
  280.    begin
  281.       TotalNodes := 0;
  282.       TopNode := 0;
  283.       ActiveNode := 0;
  284.       StartNodePtr := nil;
  285.    end;
  286. end; { StrLLInit }
  287.  
  288. function StrLLAdd(var SL:StringLL; Str:String): integer;
  289. {
  290.   Returns status indicating result of attemp to add.
  291.   Codes:          0      Success
  292.                   1      Not enough memory
  293. }
  294. var
  295.   NewPtr: StrItemPtr;
  296.   StrSize:integer;
  297. begin
  298.    StrSize := succ(length(Str));
  299.    if GoldMemAvail < sizeof(SL.StartNodePtr^) + StrSize then
  300.       StrLLAdd := 1
  301.    else
  302.    begin
  303.       StrLLAdd := 0;
  304.       if SL.StartNodePtr = nil then
  305.       begin
  306.          getmem(SL.StartNodePtr,sizeof(SL.StartNodePtr^));
  307.          SL.ActiveNode := 1;
  308.          SL.TopNode := 1;
  309.          NewPtr := SL.StartNodePtr;
  310.       end
  311.       else
  312.       begin
  313.          NewPtr := StrLLNodePtr(SL,SL.TotalNodes);
  314.          getmem(NewPtr^.NextPtr,sizeof(NewPtr^.NextPtr^));
  315.          NewPtr := NewPtr^.NextPtr;
  316.       end;
  317.       inc(SL.TotalNodes);
  318.       with NewPtr^ do
  319.       begin
  320.          NextPtr := nil;
  321.          Bits := 0;
  322.          if Str = '' then
  323.             StrPtr := nil
  324.          else
  325.          begin
  326.             getmem(StrPtr,StrSize);
  327.             move(Str[0],StrPtr^,StrSize);
  328.          end;
  329.       end;
  330.    end;
  331. end; { StrLLAdd }
  332.  
  333. function StrLLGetStr(var SL:StringLL;Num:integer): string;
  334. {}
  335. var SIP: StrItemPtr;
  336. begin
  337.    SIP := StrLLNodePtr(SL,Num);
  338.    if SIP = nil then
  339.       StrLLGetStr := ''
  340.    else
  341.    begin
  342.       if SIP^.StrPtr = nil then
  343.          StrLLGetStr := ''
  344.       else
  345.          StrLLGetStr := SIP^.StrPtr^;
  346.    end;
  347. end; { StrLLGetStr }
  348.  
  349. function StrLLWidestLine(var SL:StringLL): byte;
  350. {INTERNAL}
  351. var
  352.    W: byte;
  353.    I: integer;
  354. begin
  355.    W := 0;
  356.    for I := 1 to SL.TotalNodes do
  357.       W := GetMax(W,length(StrLLGetStr(SL,I)));
  358.    StrLLWidestLine := W;
  359. end; {StrLLWidestLine}
  360.  
  361. procedure StrLLDestroy(var SL:StringLL);
  362. {Disposes of all memory allocated in the string linked-list}
  363. var SIP1, SIP2: StrItemPtr;
  364. begin
  365.    SIP1 := SL.StartNodePtr;
  366.    while SIP1 <> nil do
  367.    begin
  368.       SIP2 := SIP1^.NextPtr;
  369.       if SIP1^.StrPtr <> nil then
  370.          freemem(SIP1^.StrPtr,succ(length(SIP1^.StrPtr^)));
  371.       freemem(SIP1,sizeof(SIP1^));
  372.       SIP1 := SIP2;
  373.    end;
  374.    StrLLInit(SL);
  375. end; { StrLLDestroy }
  376.  
  377. {$IFOPT F-}
  378.    {$DEFINE FOFF}
  379.    {$F+}
  380. {$ENDIF}
  381. function SLGetStr(P:pointer;Element,Start,Finish: longint): string;
  382. {}
  383. var Str:string;
  384. begin
  385.    Str := StrLLGetStr(StringLLPtr(P)^,Element);
  386.    SLGetStr := padleft(Str,succ(Finish-Start),' ');
  387. end; { SLGetStr }
  388.  
  389. {$IFDEF FOFF}
  390.    {$F-}
  391.    {$UNDEF FOFF}
  392. {$ENDIF}
  393.  
  394.                     {**********************************}
  395.                     {**  StrLL Automatic Population  **}
  396.                     {**********************************}
  397.  
  398. function LoadWithDrives(var SL:StringLL): integer;
  399. {Checks the system and updates the SLL with strings indicating all the valid
  400.  drives, in the format '[-A-]'
  401.     Return codes:   0  all is well!
  402.                     1  Error creating list
  403. }
  404. var I, gResult: integer;
  405.     DrvCh: char;
  406. begin
  407.    StrLLDestroy(SL);
  408.    LoadWithDrives := 0;
  409.    for I := 1 to LastDrv do
  410.    begin
  411.       DrvCh := DriveChar(I);
  412.       if DriveExists(DrvCh) then
  413.          gResult := StrLLAdd(SL,'[-'+DrvCh+'-]');
  414.       if gResult <> 0 then
  415.       begin
  416.          LoadWithDrives := 1;
  417.          exit;
  418.       end;
  419.    end;
  420. end; { LoadWithDrives }
  421.  
  422. function LoadAvailFileExtensions(var SL:StringLL;ParentDir:string): integer;
  423. {Populates the StrLL with file extensions within the ParentDir.
  424.     Return codes:   0  all is well!
  425.                     1  Error creating list
  426.                     2  Not a valid directory
  427. }
  428. var Extn,
  429.     CurDirStr: dirstr;
  430.     Found: boolean;
  431.     I, gResult: integer;
  432.     SrchRec: searchrec;
  433.  
  434.     function InList: boolean;
  435.     {}
  436.     var Temp: boolean;
  437.     begin
  438.        I := 1;
  439.        Temp := false;
  440.        while (not Temp) and (I <= SL.TotalNodes) do
  441.        begin
  442.           Temp := ('*.'+Extn = StrLLGetStr(SL,I));
  443.           inc(I);
  444.        end;
  445.        InList := Temp;
  446.     end; { InList }
  447.  
  448. begin
  449.    StrLLDestroy(SL);
  450.    gResult := 0;
  451.    LoadAvailFileExtensions := 0;
  452.    CurDirStr := CurrentPathStr;
  453.    if not SetCurrentPath(ParentDir) then
  454.       LoadAvailFileExtensions := 2
  455.    else
  456.    begin
  457.       gResult := StrLLAdd(SL,'*.*');
  458.       if gResult = 0 then
  459.       begin
  460.          findfirst(SlashedDirectory(ParentDir)+'*.*',AnyFile,SrchRec);
  461.          while (DosError = 0) and (gResult = 0) do
  462.          begin
  463.             Extn := FileExt(SrchRec.Name);
  464.             if (length(Extn) > 1) and (not InList) then
  465.             begin
  466.                gResult := StrLLAdd(SL,'*.'+Extn);
  467.                if gResult <> 0 then
  468.                begin
  469.                   LoadAvailFileExtensions := 1;
  470.                   if SetCurrentPath(CurDirStr) then ; { do nothing }
  471.                   exit;
  472.                end;
  473.             end;
  474.             findnext(SrchRec);
  475.          end;
  476.          if SetCurrentPath(CurDirStr) then ; { do nothing }
  477.       end;
  478.    end;
  479. end; { LoadAvailFileExtensions }
  480.  
  481. function LoadWithDirectories(var SL:StringLL;ParentDir:string): integer;
  482. {Populates the StrLL with all the subdirectories found in
  483.  ParentDir.
  484.     Return codes:   0  all is well!
  485.                     1  Error creating list
  486.                     2  Not a valid directory
  487. }
  488. var CurDirStr: dirstr;
  489.     SrchRec: SearchRec;
  490.     gResult: integer;
  491.     Attr: word;
  492. begin
  493.    StrLLDestroy(SL);
  494.    LoadWithDirectories := 0;
  495.    CurDirStr := CurrentPathStr;
  496.    if SetCurrentPath(ParentDir) then
  497.    begin
  498.       findfirst(SlashedDirectory(ParentDir)+'*.*',Directory,SrchRec);
  499.       while (DosError = 0) do
  500.       begin
  501.          if ((SrchRec.Attr and Directory) = Directory) then
  502.          begin
  503.             if (SrchRec.Name <> '.') then
  504.             begin
  505.                gResult := StrLLAdd(SL,'['+SrchRec.Name+']');
  506.                if gResult <> 0 then
  507.                begin
  508.                   LoadWithDirectories := 1;
  509.                   if SetCurrentPath(CurDirStr) then ;  { do nothing }
  510.                   exit;
  511.                end;
  512.             end;
  513.          end;
  514.          findnext(SrchRec);
  515.       end;
  516.       if SL.TotalNodes = 0 then
  517.          gResult := StrLLAdd(SL,LinkVars.NoDirectories);
  518.  
  519.       if SetCurrentPath(CurDirStr) then ; { do nothing }
  520.    end else
  521.    begin
  522.       LoadWithDirectories := 2;
  523.    end;
  524. end; { LoadWithDirectories }
  525.  
  526. function LoadFileMasks(var SL:StringLL;MaskStr:string): integer;
  527. {Populates the StrLL with specific file masks as indicated
  528.  in MaskStr, e.g. '*.pas *.inc *.asm'.  This indicates
  529.  to the program which file types to make available.
  530.     Return codes:  0  all is well!
  531.                    1  error creating list
  532. }
  533. var NumOfMasks,
  534.     I, gResult: integer;
  535.     Mask: string;
  536. begin
  537.    StrLLDestroy(SL);
  538.    LoadFileMasks := 0;
  539.    I := 1;
  540.    NumOfMasks := WordCnt(MaskStr);
  541.    while I < succ(NumOfMasks) do
  542.    begin
  543.       Mask := ExtractWords(I,1,MaskStr);
  544.       gResult := StrLLAdd(SL,Mask);
  545.       if (gResult <> 0) then
  546.       begin
  547.          LoadFileMasks := 1;
  548.          exit;
  549.       end else
  550.          inc(I);
  551.    end;
  552. end; { LoadFileMasks }
  553.  
  554. function LoadWithFiles(var SL:StringLL;Dir,Filemask:string;Attrib:word): integer;
  555. {Populates the StrLL with all the matching files found in
  556.  the Dir directory. Note that Filemask may contain multiple
  557.  filemasks, e.g. '*.pas *.inc *.asm'.
  558.     Return codes:   0  all is well!
  559.                     1  Error creating list
  560.                     2  Not a valid directory
  561. }
  562. var CurDirStr: dirstr;
  563.     WrdCnt,
  564.     I, gResult: integer;
  565.     Mask: string;
  566.     SrchRec: SearchRec;
  567. begin
  568.    I := 1;
  569.    StrLLDestroy(SL);
  570.    LoadWithFiles := 0;
  571.    CurDirStr := CurrentPathStr;
  572.    if SetCurrentPath(Dir) then
  573.    begin
  574.       WrdCnt := WordCnt(FileMask);
  575.       while (WrdCnt > 0) and (I < succ(WrdCnt)) do
  576.       begin
  577.          Mask := ExtractWords(I,1,FileMask);
  578.          findfirst(SlashedDirectory(Dir)+Mask,Attrib,SrchRec);
  579.          while DosError = 0 do
  580.          begin
  581.             if (SrchRec.Attr and Directory <> Directory) then
  582.             begin
  583.                gResult := StrLLAdd(SL,SrchRec.Name);
  584.                if (gResult <> 0) then
  585.                begin
  586.                   LoadWithFiles := 1;
  587.                   if SetCurrentPath(CurDirStr) then ; { do nothing }
  588.                   exit;
  589.                end;
  590.             end;
  591.             findnext(SrchRec);
  592.          end;
  593.          inc(I);
  594.       end;
  595.       if SL.TotalNodes = 0 then
  596.          gResult := StrLLAdd(SL,LinkVars.NoFilesFound);
  597.       if SetCurrentPath(CurDirStr) then ; { do nothing }
  598.    end else
  599.    LoadWithFiles := 2;
  600. end; { LoadWithFiles }
  601.  
  602.                      {***********************************}
  603.                      {**  Single Linked List Routines  **}
  604.                      {***********************************}
  605.  
  606. procedure InitSLL(var TheList:SingleLL);
  607. {}
  608. begin
  609.    with TheList do
  610.    begin
  611.       StartNodePtr := nil;
  612.       EndNodePtr := nil;
  613.       TotalNodes := 0;
  614.       StrVars := false;
  615.       Dirty := false;
  616.    end;
  617. end; {InitSLL}
  618.  
  619. procedure InitSLLStr(var TheList:SingleLL);
  620. {}
  621. begin
  622.    InitSLL(TheList);
  623.    with TheList do
  624.       StrVars := true;
  625. end; {InitSLLStr}
  626.  
  627. function _SLLNodePtr(var TheList:SingleLL;NodeNumber:longint): SingleNodePtr;
  628. {}
  629. var
  630.    I: integer;
  631.    SNP: SingleNodePtr;
  632. begin
  633.    if (NodeNumber < 1) or (NodeNumber > TheList.TotalNodes) then
  634.       _SLLNodePtr := nil
  635.    else
  636.    begin
  637.       if NodeNumber = 1 then
  638.          _SLLNodePtr := TheList.StartNodePtr
  639.       else if NodeNumber = TheList.TotalNodes then
  640.          _SLLNodePtr := TheList.EndNodePtr
  641.       else
  642.       begin
  643.          SNP := TheList.StartNodePtr;
  644.          for I := 2 to NodeNumber do
  645.             SNP := SNP^.NextPtr;
  646.          _SLLNodePtr := SNP;
  647.       end;
  648.    end;
  649. end; {_SLLNodePtr}
  650.  
  651. function SLLNodePtr(NodeNumber:longint): SingleNodePtr;
  652. {}
  653. begin
  654.    SLLNodePtr := _SLLNodePtr(LinkVars.ActiveSLL^,NodeNumber);
  655. end; {SLLNodePtr}
  656.  
  657. procedure SLLFreeNodeData(var TheList:SingleLL;Node:SingleNodePtr);
  658. {}
  659. begin
  660.    if Node <> nil then
  661.    with Node^ do
  662.    begin
  663.       if (DataPtr <> Nil) and (DataSize > 0) then
  664.          freemem(DataPtr,DataSize);
  665.       DataPtr := nil;
  666.       DataSize := 0;
  667.       TheList.Dirty := true;
  668.    end;
  669. end; {SLLFreeNodeData}
  670.  
  671. function SLLAddEngine(var TheList:SingleLL): integer;
  672. {
  673.   Returns status indicating result of attempt to add.
  674.   Codes:          0      Success
  675.                   1      Not enough memory
  676. }
  677. begin
  678.    if GoldMaxAvail < sizeof(TheList.StartNodePtr^) then
  679.       SLLAddEngine := 1  {not enough memory}
  680.    else with TheList do
  681.    begin
  682.       if StartNodePtr = nil then
  683.       begin
  684.          getmem(StartNodePtr,sizeof(StartNodePtr^));
  685.          EndNodePtr := StartNodePtr;
  686.       end
  687.       else
  688.       begin
  689.          getmem(EndNodePtr^.NextPtr,sizeof(EndNodePtr^));
  690.          EndNodePtr := EndNodePtr^.NextPtr;
  691.       end;
  692.       EndNodePtr^.NextPtr := nil;
  693.       inc(TotalNodes);
  694.       Dirty := true;
  695.       SLLAddEngine := 0;
  696.    end;
  697. end; {SLLAddEngine}
  698.  
  699. function _SLLAdd(var TheList:SingleLL;var TheData;Size:longint): integer;
  700. {
  701.   Returns status indicating result of attemp to add.
  702.   Codes:          0      Success
  703.                   1      Not enough memory
  704.                   2      Not enough memory for data
  705. }
  706. var Temp:integer;
  707. begin
  708.    Temp := SLLAddEngine(TheList);
  709.    if Temp <> 0 then
  710.       _SLLAdd := Temp
  711.    else with TheList do
  712.    begin
  713.       {now add the data to the node data pointer}
  714.       if GoldMaxAvail < Size then
  715.       begin
  716.         _SLLAdd := 2;   {not enough memory for data}
  717.         EndNodePtr^.DataSize := 0;
  718.         EndNodePtr^.DataPtr := nil;
  719.       end
  720.       else
  721.       begin
  722.          if Size > 0 then
  723.          begin
  724.             getmem(EndNodePtr^.DataPtr,Size);
  725.             move(TheData,EndNodePtr^.DataPtr^,Size);
  726.          end
  727.          else
  728.             EndNodePtr^.DataPtr := nil;
  729.          EndNodePtr^.DataSize := Size;
  730.          EndNodePtr^.Bits := 0;
  731.          _SLLAdd := 0;
  732.       end;
  733.    end;
  734. end; {_SLLAdd}
  735.  
  736. function SLLAdd(var TheData;Size:longint): integer;
  737. {}
  738. begin
  739.    SLLAdd := _SLLAdd(LinkVars.ActiveSLL^,TheData,Size);
  740. end; {SLLAdd}
  741.  
  742. function _SLLAddStr(var TheList:SingleLL;Str:string):integer;
  743. {}
  744. var
  745.   Temp,L: integer;
  746. begin
  747.    Temp := SLLAddEngine(TheList);
  748.    if Temp <> 0 then
  749.       _SLLAddStr := Temp
  750.    else with TheList do
  751.    begin
  752.       L := length(Str);
  753.       if GoldMaxAvail < succ(L) then
  754.       begin
  755.         _SLLAddStr := 2;   {not enough memory for data}
  756.         EndNodePtr^.DataSize := 0;
  757.         EndNodePtr^.DataPtr := nil;
  758.         exit;
  759.       end;
  760.       if L > 0 then
  761.       begin
  762.          getmem(EndNodePtr^.DataPtr,succ(L));
  763.          move(Str,EndNodePtr^.DataPtr^,succ(L));
  764.       end
  765.       else
  766.          EndNodePtr^.DataPtr := nil;
  767.       EndNodePtr^.DataSize := succ(L);
  768.       EndNodePtr^.Bits := 0;
  769.       _SLLAddStr := 0;
  770.    end;
  771. end; {_SLLAddStr}
  772.  
  773. function SLLAddStr(Str:string):integer;
  774. {}
  775. begin
  776.    SLLAddStr :=  _SLLAddStr(LinkVars.ActiveSLL^,Str);
  777. end; {SLLAddStr}
  778.  
  779. function _SLLChange(var TheList:SingleLL;Node:SingleNodePtr;var TheData;Size:longint): integer;
  780. { Returns status indicating result of the change attempt
  781.   Codes:          0      Success
  782.                   2      Not enough memory for data
  783.                   3      Invalid Node Ptr
  784. }
  785. begin
  786.    if node = nil then
  787.       _SLLChange := 3
  788.    else
  789.    begin
  790.      SLLFreeNodeData(TheList,Node);
  791.      if GoldMaxAvail < Size then
  792.         _SLLChange := 2
  793.      else
  794.      begin
  795.         _SLLChange := 0;
  796.         getmem(Node^.DataPtr,Size);
  797.         move(TheData,Node^.DataPtr^,Size);
  798.         Node^.DataSize := Size;
  799.      end;
  800.    end;
  801. end; {_SLLChange}
  802.  
  803. function SLLChange(Node:SingleNodePtr;var TheData;Size:longint): integer;
  804. {}
  805. begin
  806.    SLLChange := _SLLChange(LinkVars.ActiveSLL^,Node,TheData,Size);
  807. end; {SLLChange}
  808.  
  809. function _SLLChangeStr(var TheList:SingleLL;Node:SingleNodePtr;Str:string): integer;
  810. { Returns status indicating result of the change attempt
  811.   Codes:          0      Success
  812.                   2      Not enough memory for data
  813.                   3      Invalid Node Ptr
  814. }
  815. var L: byte;
  816. begin
  817.    if node = nil then
  818.       _SLLChangeStr := 3
  819.    else
  820.    begin
  821.      SLLFreeNodeData(TheList,Node);
  822.      L := succ(length(Str));
  823.      if GoldMaxAvail < L then
  824.         _SLLChangeStr := 2
  825.      else
  826.      begin
  827.         _SLLChangeStr := 0;
  828.         if L > 1 then {not empty string}
  829.         begin
  830.            getmem(Node^.DataPtr,L);
  831.            move(Str,Node^.DataPtr^,L);
  832.            Node^.DataSize := L;
  833.         end;
  834.      end;
  835.    end;
  836. end; {_SLLChangeStr}
  837.  
  838. function SLLChangeStr(Node:SingleNodePtr;Str:string): integer;
  839. {}
  840. begin
  841.    SLLChangeStr := _SLLChangeStr(LinkVars.ActiveSLL^,Node,Str);
  842. end; {SLLChangeStr}
  843.  
  844. function _SLLInsertBefore(var TheList:SingleLL;Node:SingleNodePtr;var TheData;Size:longint): integer;
  845. { Returns status indicating result of attempt to insert
  846.   Codes:          0      Success
  847.                   1      Not enough memory
  848.                   2      Not enough memory for data
  849. }
  850. var Temp,PP: SingleNodePtr;
  851. begin
  852.    if Node = nil then
  853.       _SLLInsertBefore := _SLLAdd(TheList,TheData,Size)
  854.    else if GoldMaxAvail < sizeof(Node^) then
  855.       _SLLInsertBefore:= 1  {not enough memory}
  856.    else with TheList do
  857.    begin
  858.       getmem(Temp,sizeof(Temp^));
  859.       Dirty := true;
  860.       if Node = StartNodePtr then {add to head of list}
  861.       begin
  862.          Temp^.NextPtr := StartNodePtr;
  863.          StartNodePtr := Temp;
  864.       end
  865.       else
  866.       begin
  867.          PP := StartNodePtr;
  868.          while (PP^.NextPtr <> nil) and (PP^.NextPtr <> Node) do
  869.             PP := PP^.NextPtr;
  870.          if PP^.NextPtr = nil then
  871.          begin
  872.             _SLLInsertBefore := 3;
  873.             freemem(Temp,sizeof(Temp^));
  874.             exit;
  875.          end;
  876.          Temp^.NextPtr := PP^.NextPtr;
  877.          PP^.NextPtr := Temp;
  878.       end;
  879.       inc(TotalNodes);
  880.       Node^.Bits := 0;
  881.       if GoldMaxAvail < Size then
  882.       begin
  883.          _SLLInsertBefore := 2;   {not enough memory for data}
  884.          Node^.DataSize := 0;
  885.          Node^.DataPtr := nil;
  886.       end
  887.       else
  888.       begin
  889.          if Size > 0 then
  890.          begin
  891.             getmem(Temp^.DataPtr,Size);
  892.             move(TheData,Temp^.DataPtr^,Size);
  893.          end
  894.          else
  895.            Temp^.DataPtr := nil;
  896.          Temp^.DataSize := Size;
  897.          _SLLInsertBefore := 0;
  898.       end;
  899.    end;
  900. end; {_SLLInsertBefore}
  901.  
  902. function SLLInsertBefore(Node:SingleNodePtr;var TheData;Size:longint): integer;
  903. {}
  904. begin
  905.    SLLInsertBefore := _SLLInsertBefore(LinkVars.ActiveSLL^,Node,TheData,Size);
  906. end; {SLLInsertBefore}
  907.  
  908. function _SLLInsStrBefore(var TheList:SingleLL;Node:SingleNodePtr;Str:string): integer;
  909. {}
  910. begin
  911.    if Str = '' then
  912.       _SLLInsStrBefore := _SLLInsertBefore(TheList,Node,Str,0)
  913.    else
  914.       _SLLInsStrBefore := _SLLInsertBefore(TheList,Node,Str,succ(length(Str)));
  915. end; {_SLLInsStrBefore}
  916.  
  917. function SLLInsStrBefore(Node:SingleNodePtr;Str:string): integer;
  918. {}
  919. begin
  920.    SLLInsStrBefore :=_SLLInsStrBefore(LinkVars.ActiveSLL^,Node,Str);
  921. end; {SLLInsStrBefore}
  922.  
  923. procedure _SLLDelNode(var TheList:SingleLL;Node:SingleNodePtr);
  924. {}
  925. var PP: SingleNodePtr;
  926. begin
  927.    if Node <> nil then with TheList do
  928.    begin
  929.       if Node = StartNodePtr then
  930.          StartNodePtr := StartNodePtr^.NextPtr
  931.       else
  932.       begin
  933.          PP := StartNodePtr;
  934.          while (PP^.NextPtr <> nil) and (PP^.NextPtr <> Node) do
  935.             PP := PP^.NextPtr;
  936.          if PP^.NextPtr = nil then
  937.             exit; {node not found; just exit}
  938.          if Node = EndNodePtr then
  939.          begin
  940.            EndNodePtr := PP;
  941.            EndNodePtr^.NextPtr := nil;
  942.          end
  943.          else
  944.            PP^.NextPtr := PP^.NextPtr^.NextPtr;
  945.       end;
  946.       SLLFreeNodeData(TheList,Node);
  947.       freemem(Node,sizeof(Node^));
  948.       dec(TotalNodes);
  949.    end;
  950. end; {_SLLDelNode}
  951.  
  952. procedure SLLDelNode(Node:SingleNodePtr);
  953. {}
  954. begin
  955.    _SLLDelNode(LinkVars.ActiveSLL^,Node);
  956. end; {SLLDelNode}
  957.  
  958. procedure SLLGetNodeData(Node:SingleNodePtr;Var TheData);
  959. {}
  960. begin
  961.    if Node <> nil then
  962.       move(Node^.DataPtr^,TheData,Node^.DataSize);
  963. end; {SLLGetNodeData}
  964.  
  965. function SLLGetNodeDataSize(Node:SingleNodePtr):longint;
  966. {}
  967. begin
  968.    if Node <> nil then
  969.       SLLGetNodeDataSize := Node^.DataSize
  970.    else
  971.       SLLGetNodeDataSize := 0;
  972. end; {SLLGetNodeDataSize}
  973.  
  974. function _SLLGetNodeStr(var TheList:SingleLL;Node:SingleNodePtr; Len:byte): string;
  975. {}
  976. var
  977.    Temp:string;
  978.    L:integer;
  979. begin
  980.    if (Node = Nil)
  981.    or (Node^.DataPtr = Nil)
  982.    or (Node^.DataSize = 0) then
  983.       _SLLGetNodeStr := ''
  984.    else
  985.    begin
  986.       if TheList.StrVars then
  987.       begin
  988.          move(Node^.DataPtr^,Temp,Node^.DataSize);
  989.          _SLLGetNodeStr := Temp;
  990.       end
  991.       else
  992.       begin
  993.          if (len < 1) or (Len > Node^.DataSize) then
  994.             L := Node^.DataSize
  995.          else
  996.             L := Len;
  997.          move(Node^.DataPtr^,Temp[1],L);
  998.          Temp [0] := chr(L);
  999.          _SLLGetNodeStr := Temp;
  1000.       end;
  1001.    end;
  1002. end; {_SLLGetNodeStr}
  1003.  
  1004. function SLLGetNodeStr(Node:SingleNodePtr; Len:byte): string;
  1005. {}
  1006. begin
  1007.    SLLGetNodeStr := _SLLGetNodeStr(LinkVars.ActiveSLL^,Node,Len);
  1008. end; {SLLGetNodeStr}
  1009.  
  1010. function _SLLGetStr(var TheList:SingleLL;Num:longint):string;
  1011. {}
  1012. var SNP: SingleNodePtr;
  1013. begin
  1014.    SNP := _SLLNodePtr(TheList,Num);
  1015.    if SNP =  nil then
  1016.       _SLLGetStr := ''
  1017.    else
  1018.       _SLLGetStr := _SLLGetNodeStr(TheList,SNP,0);
  1019. end; {_SLLGetStr}
  1020.  
  1021. function SLLGetStr(Num:longint):string;
  1022. {}
  1023. begin
  1024.    SLLGetStr := _SLLGetStr(LinkVars.ActiveSLL^,Num);
  1025. end; {SLLGetStr}
  1026.  
  1027. procedure _SLLSetBit(var TheList:SingleLL;Node:SingleNodePtr; BitPos:byte; On:boolean);
  1028. {}
  1029. begin
  1030.    if Node <> nil then
  1031.    begin
  1032.       SetBitStatus(Node^.Bits,BitPos,On);
  1033.       TheList.Dirty := true;
  1034.    end;
  1035. end; { _SLLSetBit }
  1036.  
  1037. procedure SLLSetBit(Node:SingleNodePtr; BitPos:byte; On:boolean);
  1038. {}
  1039. begin
  1040.    _SLLSetBit(LinkVars.ActiveSLL^,Node,BitPos,On);
  1041. end; {SLLSetBit}
  1042.  
  1043. function SLLGetBit(Node:SingleNodePtr; BitPos:byte): boolean;
  1044. {}
  1045. begin
  1046.    if Node <> nil then
  1047.       SLLGetBit := GetBitStatus(Node^.Bits,BitPos)
  1048.    else
  1049.       SLLGetBit := false;
  1050. end; { SLLGetBit }
  1051.  
  1052. function _SLLGetTagState(var TheList:SingleLL;Num:longint):boolean;
  1053. {}
  1054. var SNP: SingleNodePtr;
  1055. begin
  1056.    SNP := _SLLNodePtr(TheList,Num);
  1057.    if SNP <> nil then
  1058.       _SLLGetTagState := SLLGetBit(SNP,TagBit)
  1059.    else
  1060.       _SLLGetTagState := false;
  1061. end; {SLLGetTagState}
  1062.  
  1063. function SLLGetTagState(Num:longint):boolean;
  1064. {}
  1065. begin
  1066.    SLLGetTagState := _SLLGetTagState(LinkVars.ActiveSLL^,Num);
  1067. end; {SLLGetTagState}
  1068.  
  1069. procedure _SLLDelAllStatus(var TheList:SingleLL;BitPos:byte;On:boolean);
  1070. {}
  1071. var
  1072.    TempPtr,TempNextPtr: SingleNodePtr;
  1073. begin
  1074.    if TheList.StartNodePtr <> nil then with TheList do
  1075.    begin
  1076.       TempPtr := StartNodePtr;
  1077.       TempNextPtr := TempPtr^.NextPtr;
  1078.       while TempNextPtr <> nil do
  1079.       begin
  1080.          if GetBitStatus(TempNextPtr^.Bits,BitPos) = On then
  1081.             _SLLDelNode(TheList,TempNextPtr)
  1082.          else
  1083.             TempPtr := TempPtr^.NextPtr;
  1084.          TempNextPtr := TempPtr^.NextPtr;
  1085.       end;
  1086.       if GetBitStatus(StartNodePtr^.Bits,BitPos) = On then
  1087.          _SLLDelNode(TheList,StartNodePtr);
  1088.    end;
  1089. end; {_SLLDelAllStatus}
  1090.  
  1091. procedure SLLDelAllStatus(BitPos:byte;On:boolean);
  1092. {}
  1093. begin
  1094.    _SLLDelAllStatus(LinkVars.ActiveSLL^,BitPos,On);
  1095. end; {SLLDelAllStatus}
  1096.  
  1097. procedure _SLLDestroy(var TheList:SingleLL);
  1098. {}
  1099. var Temp1,Temp2: SingleNodePtr;
  1100. begin
  1101.    Temp1 := TheList.StartNodePtr;
  1102.    while Temp1 <> nil do
  1103.    begin
  1104.       Temp2 := Temp1^.NextPtr;
  1105.       SLLFreeNodeData(TheList,Temp1);
  1106.       freemem(Temp1,sizeof(Temp1^));
  1107.       Temp1 := Temp2;
  1108.    end;
  1109.    TheList.StartNodePtr := nil;
  1110.    TheList.EndNodePtr := nil;
  1111.    TheList.TotalNodes := 0;
  1112. end; {_SLLDestroy}
  1113.  
  1114. procedure SLLDestroy;
  1115. {}
  1116. begin
  1117.    _SLLDestroy(LinkVars.ActiveSLL^);
  1118. end; {SLLDestroy}
  1119.  
  1120. procedure SLLEmptyList;
  1121. {}
  1122. begin
  1123.    SLLDestroy;
  1124. end; {SLLEmptyList}
  1125.  
  1126.                         {**************************}
  1127.                         {**  SLL File Functions  **}
  1128.                         {**************************}
  1129.  
  1130. function _SLLLoadFromFile(var TheList:SingleLL;Filename:string):integer;
  1131. {Opens a file as text, reads in each line as a node, then closes the file
  1132.     Return codes:   0  all is well!
  1133.                     1  file not found
  1134.                     2  Error Reading file
  1135.                     3  Error creating list
  1136. }
  1137. var
  1138.   F: text;
  1139.   TempStr:string;
  1140. begin
  1141.    assign(F, Filename);
  1142.    {$I-}
  1143.    reset(F);
  1144.    {$I+}
  1145.    if IOResult <> 0 then
  1146.       _SLLLoadFromFile := 1
  1147.    else
  1148.    begin
  1149.       _SLLDestroy(TheList);                     {empty the list}
  1150.       while not eof(F) do
  1151.       begin
  1152.          {$I-}
  1153.          readln(F,TempStr);
  1154.          {$I+}
  1155.          if IOResult <> 0 then
  1156.          begin
  1157.             close(F);
  1158.             _SLLLoadFromFile := 2;
  1159.             exit;
  1160.          end;
  1161.          if _SLLAddStr(TheList,TempStr) <> 0 then
  1162.          begin
  1163.             close(F);
  1164.             _SLLLoadFromFile := 3;
  1165.             exit;
  1166.          end;
  1167.       end;
  1168.       close(F);
  1169.       _SLLLoadFromFile := 0;
  1170.    end;
  1171. end; {_SLLLoadFromFile}
  1172.  
  1173. function SLLLoadFromFile(Filename:string):integer;
  1174. {}
  1175. begin
  1176.    SLLLoadFromFile := _SLLLoadFromFile(LinkVars.ActiveSLL^,Filename);
  1177. end; {SLLLoadFromFile}
  1178.  
  1179. function SLLSaveToFile(Filename:string):integer;
  1180. {Rewrites the file (erasing its contents) then saves the file SLL data
  1181. as strings in a text file
  1182.     Return codes:   0  all is well!
  1183.                     1  Unable to open file
  1184.                     2  Error Writing file
  1185. }
  1186. var
  1187.   F: text;
  1188.   TempStr:string;
  1189.   Temp1,Temp2: SingleNodePtr;
  1190. begin
  1191.    assign(F, Filename);
  1192.    {$I-}
  1193.    rewrite(F);
  1194.    {$I+}
  1195.    if IOResult <> 0 then
  1196.       SLLSaveToFile := 1
  1197.    else
  1198.    begin
  1199.       Temp1 := LinkVars.ActiveSLL^.StartNodePtr;
  1200.       while Temp1 <> nil do
  1201.       begin
  1202.          Temp2 := Temp1^.NextPtr;
  1203.          {$I-}
  1204.          writeln(F,SLLGetNodeStr(Temp1,255));
  1205.          {$I+}
  1206.          if IOResult <> 0 then
  1207.          begin
  1208.             close(F);
  1209.             SLLSaveToFile := 2;
  1210.             exit;
  1211.          end;
  1212.          Temp1 := Temp2;
  1213.       end;
  1214.       close(F);
  1215.       SLLSaveToFile := 0
  1216.    end;
  1217. end; {SLLSaveToFile}
  1218.  
  1219.                     {*********************************}
  1220.                     {**  Double Link List Routines  **}
  1221.                     {*********************************}
  1222.  
  1223. {$IFOPT F-}
  1224.    {$DEFINE FOFF}
  1225.    {$F+}
  1226. {$ENDIF}
  1227. function DLLDefWrongOrder(SortID:shortint;Node1,Node2:DoubleNodePtr;Asc:boolean): boolean;
  1228. {}
  1229. var
  1230.   B1,B2:byte;
  1231. begin
  1232.    if LinkVars.ActiveDLL^.StrVars then
  1233.    begin
  1234.       if Asc then
  1235.          DLLDefWrongOrder := string(Node2^.DataPtr^) < string(Node1^.DataPtr^)
  1236.       else
  1237.          DLLDefWrongOrder := string(Node1^.DataPtr^) < string(Node2^.DataPtr^)
  1238.    end
  1239.    else
  1240.    begin
  1241.       move(Node1^.DataPtr^,B1,1);
  1242.       move(Node2^.DataPtr^,B2,1);
  1243.       if Asc then
  1244.          DLLDefWrongOrder := B2 > B1
  1245.       else
  1246.          DLLDefWrongOrder := B1 > B2
  1247.    end;
  1248. end; {DLLDefWrongOrder}
  1249.  
  1250. function DLLDefGetStr(Node:DoubleNodePtr;Start,Finish: longint): string;
  1251. {}
  1252. var
  1253.   temp: string;
  1254. begin
  1255.    if Start < 0 then Start := 0;
  1256.    if Finish < 0 then Finish := 0;
  1257.    {validate Start and Finish Parameters}
  1258.    if ((Finish = 0) and (Start = 0))
  1259.    or (Start > Finish) then   {get full string}
  1260.    begin
  1261.       Start := 1;
  1262.       Finish := 255;
  1263.    end
  1264.    else if Finish - Start > 254 then      {too long to fit in string}
  1265.       Finish := Start + 254;
  1266.    if (Node = Nil)
  1267.    or (Node^.DataPtr = Nil)
  1268.    or (Node^.DataSize = 0)
  1269.    or (Start > Node^.DataSize) then
  1270.       DLLDefGetStr := ''
  1271.    else
  1272.    begin
  1273.       if Finish > Node^.DataSize then
  1274.          Finish := Node^.DataSize;
  1275.       if Start = 0 then
  1276.          inc(Start);
  1277.       if LinkVars.ActiveDLL^.StrVars then
  1278.       begin
  1279.          move(Node^.DataPtr^,Temp,256);
  1280.          DLLDefGetStr := copy(Temp,Start,succ(Finish-Start));
  1281.       end
  1282.       else
  1283.       begin
  1284.          move(mem[seg(Node^.DataPtr^):ofs(Node^.DataPtr^)+pred(Start)],Temp[1],succ(Finish-Start));
  1285.          Temp [0] := chr(succ(Finish-Start));
  1286.          DLLDefGetStr := Temp;
  1287.       end;
  1288.    end;
  1289. end; {DLLDefGetStr}
  1290. {$IFDEF FOFF}
  1291.    {$F-}
  1292.    {$UNDEF FOFF}
  1293. {$ENDIF}
  1294.  
  1295. procedure DLLAssignWrongOrderFunc(Func:DLLWrongOrderFunc);
  1296. {}
  1297. begin
  1298.    if LinkVars.ActiveDLL <> nil then
  1299.       LinkVars.ActiveDLL^.WrongOrder := Func;
  1300. end; {DLLAssignWrongOrderFunc}
  1301.  
  1302. procedure DLLAssignGetStrFunc(Func:DLLGetStrFunc);
  1303. {}
  1304. begin
  1305.    LinkVars.ActiveDLL^.GetStr := Func;
  1306. end; {DLLAssignGetStrFunc}
  1307.  
  1308. procedure InitDLLEngine(var TheList:DoubleLL);
  1309. {}
  1310. begin
  1311.    with TheList do
  1312.    begin
  1313.       StartNodePtr := nil;
  1314.       EndNodePtr := nil;
  1315.       ActiveNodePtr := nil;
  1316.       TotalNodes := 0;
  1317.       ActiveNodeNumber := 0;
  1318.       SortID := 0;
  1319.       SortAscending := true;
  1320.       Dirty := false;
  1321.       WrongOrder := DLLDefWrongOrder;
  1322.       GetStr := DLLDefGetStr;
  1323.    end;
  1324. end; {InitDLLEngine}
  1325.  
  1326. procedure InitDLL(var TheList:DoubleLL);
  1327. {}
  1328. begin
  1329.    InitDLLEngine(TheList);
  1330.    TheList.StrVars := false;
  1331. end; {InitDLL}
  1332.  
  1333. procedure InitDLLStr(var TheList:DoubleLL);
  1334. {}
  1335. begin
  1336.    InitDLLEngine(TheList);
  1337.    TheList.StrVars := true;
  1338. end; {InitDLLStr}
  1339.  
  1340. procedure DLLFreeNodeData(Node:DoubleNodePtr);
  1341. {INTERNAL}
  1342. begin
  1343.    if Node <> nil then
  1344.    with Node^ do
  1345.    begin
  1346.       if (DataPtr <> Nil) and (DataSize > 0) then
  1347.          freemem(DataPtr,DataSize);
  1348.       DataPtr := nil;
  1349.       DataSize := 0;
  1350.       LinkVars.ActiveDLL^.Dirty := true;
  1351.    end;
  1352. end; {DLLFreeNodeData}
  1353.  
  1354. function DLLAddEngine: integer;
  1355. { Adds node after the ActiveNodePtr, and increments the
  1356.   ActiveNodePtr.
  1357.  
  1358.   Returns status indicating result of attemp to add.
  1359.   Codes:          0      Success
  1360.                   1      Not enough memory
  1361.  
  1362. }
  1363. var
  1364.   Temp: DoubleNodePtr;
  1365. begin
  1366.    DLLAddEngine := 0;
  1367.    if GoldMaxAvail < sizeof(LinkVars.ActiveDLL^.StartNodePtr^) then
  1368.       DLLAddEngine := 1  {not enough memory}
  1369.    else with LinkVars.ActiveDLL^ do
  1370.    begin
  1371.       if StartNodePtr = nil then
  1372.       begin
  1373.          getmem(StartNodePtr,sizeof(StartNodePtr^));
  1374.          StartNodePtr^.PrevPtr := nil;
  1375.          StartNodePtr^.NextPtr := nil;
  1376.          ActiveNodePtr := StartNodePtr;
  1377.          ActiveNodeNumber := 1;
  1378.          EndNodePtr := ActiveNodePtr;
  1379.       end
  1380.       else
  1381.       begin
  1382.          if ActiveNodePtr^.NextPtr = nil then {end of list}
  1383.          begin
  1384.             getmem(ActiveNodePtr^.NextPtr,sizeof(ActiveNodePtr^));
  1385.             ActiveNodePtr^.NextPtr^.PrevPtr := ActiveNodePtr;
  1386.             ActiveNodePtr := ActiveNodePtr^.NextPtr;
  1387.             ActiveNodePtr^.NextPtr := nil;
  1388.             inc(ActiveNodeNumber);
  1389.             EndNodePtr := ActiveNodePtr;
  1390.          end
  1391.          else  {insert a node}
  1392.          begin
  1393.             getmem(Temp,sizeof(Temp^));
  1394.             ActiveNodePtr^.NextPtr^.PrevPtr := Temp;
  1395.             Temp^.NextPtr := ActiveNodePtr^.NextPtr;
  1396.             Temp^.PrevPtr := ActiveNodePtr;
  1397.             ActiveNodePtr^.NextPtr := Temp;
  1398.             ActiveNodePtr := Temp;
  1399.             inc(ActiveNodeNumber);
  1400.          end;
  1401.       end;
  1402.       inc(TotalNodes);
  1403.       LinkVars.ActiveDLL^.Dirty := true;
  1404.    end;
  1405. end; {DLLAddEngine}
  1406.  
  1407. function DLLAdd(var TheData;Size:longint): integer;
  1408. { Adds node after the ActiveNodePtr, and increments the
  1409.   ActiveNodePtr.
  1410.  
  1411.   Returns status indicating result of attemp to add.
  1412.   Codes:          0      Success
  1413.                   1      Not enough memory
  1414.                   2      Not enough memory for data
  1415.                   99     List not active
  1416. }
  1417. var
  1418.   Temp: integer;
  1419. begin
  1420.    if LinkVars.ActiveDLL <> nil then
  1421.    begin
  1422.       Temp := DLLAddEngine;
  1423.       if Temp <> 0 then
  1424.          DLLAdd := Temp
  1425.       else with LinkVars.ActiveDLL^ do
  1426.       begin
  1427.          {now add the data to the node data pointer}
  1428.          if GoldMaxAvail < Size then
  1429.          begin
  1430.            DLLAdd := 2;   {not enough memory for data}
  1431.            ActiveNodePtr^.DataSize := 0;
  1432.            ActiveNodePtr^.DataPtr := nil;
  1433.            exit;
  1434.          end;
  1435.          if Size > 0 then
  1436.          begin
  1437.             getmem(ActiveNodePtr^.DataPtr,Size);
  1438.             move(TheData,ActiveNodePtr^.DataPtr^,Size);
  1439.          end
  1440.          else
  1441.             ActiveNodePtr^.DataPtr := nil;
  1442.          ActiveNodePtr^.DataSize := Size;
  1443.          ActiveNodePtr^.Bits := 0;
  1444.          DLLAdd := 0;
  1445.       end;
  1446.    end
  1447.    else
  1448.       DLLAdd := 99;
  1449. end; {DLLAdd}
  1450.  
  1451. function DLLAddStr(Str:string):integer;
  1452. {}
  1453. var
  1454.   Temp,L: integer;
  1455. begin
  1456.    if LinkVars.ActiveDLL <> nil then
  1457.    begin
  1458.       Temp := DLLAddEngine;
  1459.       if Temp <> 0 then
  1460.          DLLAddStr := Temp
  1461.       else with LinkVars.ActiveDLL^ do
  1462.       begin
  1463.          L := length(Str);
  1464.          if GoldMaxAvail < succ(L) then
  1465.          begin
  1466.            DLLAddStr := 2;   {not enough memory for data}
  1467.            ActiveNodePtr^.DataSize := 0;
  1468.            ActiveNodePtr^.DataPtr := nil;
  1469.            exit;
  1470.          end;
  1471.          if L > 0 then
  1472.          begin
  1473.             getmem(ActiveNodePtr^.DataPtr,succ(L));
  1474.             move(Str,ActiveNodePtr^.DataPtr^,succ(L));
  1475.          end
  1476.          else
  1477.             ActiveNodePtr^.DataPtr := nil;
  1478.          ActiveNodePtr^.DataSize := succ(L);
  1479.          ActiveNodePtr^.Bits := 0;
  1480.          DLLAddStr := 0;
  1481.       end;
  1482.    end
  1483.    else
  1484.       DLLAddStr := 99;
  1485. end; {DLLAddStr}
  1486.  
  1487. function DLLChange(Node:DoubleNodePtr;var TheData;Size:longint): integer;
  1488. { Returns status indicating result of the change attempt
  1489.   Codes:          0      Success
  1490.                   2      Not enough memory for data
  1491.                   3      Invalid Node Ptr
  1492. }
  1493. begin
  1494.    if Node = nil then
  1495.       DLLChange := 3
  1496.    else 
  1497.    begin
  1498.      DLLFreeNodeData(Node);
  1499.      if GoldMaxAvail < Size then
  1500.         DLLChange := 2
  1501.      else
  1502.      begin
  1503.         DLLChange := 0;
  1504.         getmem(Node^.DataPtr,Size);
  1505.         move(TheData,Node^.DataPtr^,Size);
  1506.         Node^.DataSize := Size;
  1507.      end;
  1508.    end;
  1509. end; {DLLChange}
  1510.  
  1511. function DLLInsertBefore(Node:DoubleNodePtr;var TheData;Size:longint): integer;
  1512. { Returns status indicating result of attempt to insert
  1513.   Codes:          0      Success
  1514.                   1      Not enough memory
  1515.                   2      Not enough memory for data
  1516. }
  1517. var
  1518.   Temp: DoubleNodePtr;
  1519. begin
  1520.    if node = nil then
  1521.       DLLInsertBefore := DLLAdd(TheData,Size)
  1522.    else if GoldMaxAvail < sizeOf(Node^) then
  1523.       DLLInsertBefore:= 1  {not enough memory}
  1524.    else with LinkVars.ActiveDLL^ do
  1525.    begin
  1526.       if Node = StartNodePtr then {add to head of list}
  1527.       begin
  1528.          getmem(Node^.PrevPtr,sizeof(Node^));
  1529.          Node^.PrevPtr^.NextPtr := Node;
  1530.          Node := Node^.PrevPtr;
  1531.          Node^.PrevPtr := nil;
  1532.          StartNodePtr := Node;
  1533.       end
  1534.       else     {middle of list}
  1535.       begin
  1536.          getmem(Temp,sizeof(Temp^));
  1537.          Node^.PrevPtr^.NextPtr := Temp;
  1538.          Temp^.PrevPtr := Node^.PrevPtr;
  1539.          Node^.PrevPtr := Temp;
  1540.          Temp^.NextPtr := Node;
  1541.          Node := Temp;
  1542.       end;
  1543.       inc(TotalNodes);
  1544.       LinkVars.ActiveDLL^.Dirty := true;
  1545.       ActiveNodeNumber := 1;
  1546.       ActiveNodePtr := StartNodePtr;
  1547.       if GoldMaxAvail < Size then
  1548.       begin
  1549.          DLLInsertBefore := 2;   {not enough memory for data}
  1550.          Node^.DataSize := 0;
  1551.          Node^.DataPtr := nil;
  1552.       end
  1553.       else
  1554.       begin
  1555.          if Size > 0 then
  1556.          begin
  1557.             getmem(Node^.DataPtr,Size);
  1558.             move(TheData,Node^.DataPtr^,Size);
  1559.          end
  1560.          else
  1561.            Node^.DataPtr := nil;
  1562.          Node^.DataSize := Size;
  1563.          DLLInsertBefore := 0;
  1564.       end;
  1565.    end;
  1566. end; {DLLInsertBefore}
  1567.  
  1568. procedure DLLDelNode(Node:DoubleNodePtr);
  1569. {if a nil pointer is passed nothing is deleted}
  1570. begin
  1571.    if Node <> nil then
  1572.    with LinkVars.ActiveDLL^ do
  1573.    begin
  1574.       if ActiveNodePtr = Node then   {move activeptr to next/prev entry in list}
  1575.       begin
  1576.          if ActiveNodePtr^.NextPtr = nil then
  1577.          begin
  1578.             dec(ActiveNodeNumber);
  1579.             ActiveNodePtr := ActiveNodePtr^.PrevPtr;
  1580.          end
  1581.          else
  1582.             ActiveNodePtr := ActiveNodePtr^.NextPtr;
  1583.       end;
  1584.       if Node = StartNodePtr then
  1585.       begin
  1586.          if Node^.NextPtr = nil then {only node in list}
  1587.          begin
  1588.             DLLFreeNodeData(Node);
  1589.             freemem(StartNodePtr,sizeof(StartNodePtr^));
  1590.             StartNodePtr := nil;
  1591.             EndNodePtr := nil;
  1592.          end
  1593.          else
  1594.          begin
  1595.             StartNodePtr := StartNodePtr^.NextPtr;
  1596.             StartNodePtr^.PrevPtr := nil;
  1597.             DLLFreeNodeData(Node);
  1598.             freemem(Node,sizeof(Node^));
  1599.          end;
  1600.       end
  1601.       else        {in body of list}
  1602.       begin
  1603.          Node^.PrevPtr^.NextPtr := Node^.NextPtr;
  1604.          if Node = EndNodePtr then
  1605.             EndNodePtr := EndNodePtr^.PrevPtr
  1606.          else
  1607.             Node^.NextPtr^.PrevPtr := Node^.PrevPtr;
  1608.          DLLFreeNodeData(Node);
  1609.          freemem(Node,sizeof(Node^));
  1610.       end;
  1611.       dec(TotalNodes);
  1612.    end;
  1613. end; {DLLDelNode}
  1614.  
  1615. procedure DLLGetNodeData(Node:DoubleNodePtr;Var TheData);
  1616. {}
  1617. begin
  1618.    if Node <> nil then
  1619.      with Node^ do
  1620.         if DataPtr <> Nil then
  1621.            move(DataPtr^,TheData,DataSize);
  1622. end; {DLLGetNodeData}
  1623.  
  1624. function DLLGetNodeDataSize(Node:DoubleNodePtr):longint;
  1625. {}
  1626. begin
  1627.    if Node <> nil then
  1628.      with Node^ do
  1629.         if DataPtr <> Nil then
  1630.            DLLGetNodeDataSize := 0
  1631.         else
  1632.            DLLGetNodeDataSize := DataSize;
  1633. end; {DLLGetNodeDataSize}
  1634.  
  1635. procedure DLLSwapNodes(Node1,Node2:DoubleNodePtr);
  1636. {}
  1637. var
  1638.   Ptr1: pointer;
  1639.   Size1: longint;
  1640.   Status1: byte;
  1641.   Ecode: integer;
  1642. begin
  1643.    Status1 := Node1^.Bits;
  1644.    Node1^.Bits := Node2^.Bits;
  1645.    Node2^.Bits := Status1;
  1646.    Size1 := Node1^.DataSize;
  1647.    if Size1 > 0 then
  1648.    begin
  1649.       getmem(Ptr1,size1);
  1650.       DLLGetNodeData(Node1,Ptr1^);
  1651.    end;
  1652.    Ecode := DLLChange(Node1,Node2^.DataPtr^,Node2^.DataSize);
  1653.    Ecode := DLLChange(Node2,Ptr1^,Size1);
  1654.    if Size1 > 0 then
  1655.       freemem(Ptr1,Size1);
  1656. end; {DLLSwapNodes}
  1657.  
  1658. procedure DLLDelAllStatus(BitPos:byte;On:boolean);
  1659. {}
  1660. var
  1661.   TempPtr,TempNextPtr: DoubleNodePtr;
  1662. begin
  1663.    if (LinkVars.ActiveDLL <> nil)
  1664.    and (LinkVars.ActiveDLL^.StartNodePtr <> nil) then with LinkVars.ActiveDLL^ do
  1665.    begin
  1666.       TempPtr := StartNodePtr;
  1667.       TempNextPtr := TempPtr^.NextPtr;
  1668.       while TempNextPtr <> nil do
  1669.       begin
  1670.          if GetBitStatus(TempNextPtr^.Bits,BitPos) = On then
  1671.             DLLDelNode(TempNextPtr)
  1672.          else
  1673.             TempPtr := TempPtr^.NextPtr;
  1674.          TempNextPtr := TempPtr^.NextPtr;
  1675.       end;
  1676.       if GetBitStatus(StartNodePtr^.Bits,BitPos) = On then
  1677.          DLLDelNode(StartNodePtr);
  1678.    end;
  1679. end; {DLLDelAllStatus}
  1680.  
  1681. procedure DLLAdvance(Amount:longint);
  1682. {}
  1683. var
  1684.   I : longint;
  1685. begin
  1686.    if (LinkVars.ActiveDLL <> nil) then
  1687.       for I := 1 to Amount do
  1688.          if LinkVars.ActiveDLL^.ActiveNodePtr^.NextPtr <> nil then
  1689.          begin
  1690.              LinkVars.ActiveDLL^.ActiveNodePtr := LinkVars.ActiveDLL^.ActiveNodePtr^.NextPtr;
  1691.              inc(LinkVars.ActiveDLL^.ActiveNodeNumber);
  1692.          end;
  1693. end; {DLLAdvance}
  1694.  
  1695. procedure DLLRetreat(Amount:longint);
  1696. {}
  1697. var
  1698.   I : longint;
  1699. begin
  1700.    if (LinkVars.ActiveDLL <> nil) then
  1701.       for I := 1 to Amount do
  1702.          if LinkVars.ActiveDLL^.ActiveNodePtr^.PrevPtr <> nil then
  1703.          begin
  1704.              LinkVars.ActiveDLL^.ActiveNodePtr := LinkVars.ActiveDLL^.ActiveNodePtr^.PrevPtr;
  1705.              dec(LinkVars.ActiveDLL^.ActiveNodeNumber);
  1706.          end;
  1707. end; {DLLRetreat}
  1708.  
  1709. function DLLNodePtr(NodeNumber:longint): DoubleNodePtr;
  1710. {}
  1711. var
  1712.   StartNode: DoubleNodePtr;
  1713.   DistanceA,
  1714.   DistanceB,
  1715.   DistanceC,
  1716.   Counter,
  1717.   I: LongInt;
  1718.   Forwards : boolean;
  1719.   Indicator : byte;
  1720. begin
  1721.    if (NodeNumber < 1)
  1722.    or (LinkVars.ActiveDLL = nil)
  1723.    or (NodeNumber > LinkVars.ActiveDLL^.TotalNodes) then
  1724.       DLLNodePtr := nil
  1725.    else with LinkVars.ActiveDLL^ do
  1726.    begin
  1727.       if NodeNumber = 1 then
  1728.          DLLNodePtr := StartNodePtr
  1729.       else if NodeNumber = TotalNodes then
  1730.          DLLNodePtr := EndNodePtr
  1731.       else if NodeNumber = ActiveNodeNumber then
  1732.          DLLNodePtr := ActiveNodePtr
  1733.       else
  1734.       begin
  1735.          {check for the nearest node ptr, and jump from there}
  1736.          DistanceA := abs(NodeNumber - ActiveNodeNumber);
  1737.          DistanceB := NodeNumber;
  1738.          DistanceC := TotalNodes - NodeNumber;
  1739.          if DistanceA < DistanceB then
  1740.          begin
  1741.             if DistanceA < DistanceC then
  1742.             begin
  1743.                StartNode := ActiveNodePtr;
  1744.                Forwards := (ActiveNodeNumber < NodeNumber);
  1745.                Counter := DistanceA;
  1746.             end
  1747.             else
  1748.             begin
  1749.                StartNode := EndNodePtr;
  1750.                Forwards := false;
  1751.                Counter := DistanceC;
  1752.             end;
  1753.          end
  1754.          else      {DA > DB}
  1755.          begin
  1756.             if DistanceB < DistanceC then
  1757.             begin
  1758.                StartNode := StartNodePtr;
  1759.                Forwards := true;
  1760.                Counter := pred(DistanceB);
  1761.             end
  1762.             else
  1763.             begin
  1764.                StartNode := EndNodePtr;
  1765.                Forwards := false;
  1766.                Counter := DistanceC;
  1767.             end;
  1768.          end;
  1769.          if Forwards then
  1770.             for I := 1 to Counter do
  1771.                 StartNode := StartNode^.NextPtr
  1772.          else
  1773.             for I := 1 to Counter do
  1774.                 StartNode := StartNode^.PrevPtr;
  1775.          DLLNodePtr := StartNode;
  1776.       end;
  1777.   end;
  1778. end; {DLLNodePtr}
  1779.  
  1780. procedure DLLJump(NodeNumber:longint);
  1781. {}
  1782. begin
  1783.    if  LinkVars.ActiveDLL <> nil then
  1784.    with LinkVars.ActiveDLL^ do
  1785.    begin
  1786.       if NodeNumber = 1 then
  1787.       begin
  1788.          ActiveNodePtr := StartNodePtr;
  1789.          ActiveNodeNumber := 1;
  1790.       end
  1791.       else
  1792.       begin
  1793.          if NodeNumber < ActiveNodeNumber then
  1794.             DLLRetreat(ActiveNodeNumber - NodeNumber)
  1795.          else
  1796.             DLLAdvance(NodeNumber - ActiveNodeNumber);
  1797.       end;
  1798.    end;
  1799. end; {DLLJump}
  1800.  
  1801. procedure DLLShiftActiveNode(NewNode: DoubleNodePtr; NodeNumber: longint);
  1802. {}
  1803. begin
  1804.    if  LinkVars.ActiveDLL <> nil then
  1805.    begin
  1806.       LinkVars.ActiveDLL^.ActiveNodePtr := NewNode;
  1807.       LinkVars.ActiveDLL^.ActiveNodeNumber := NodeNumber;
  1808.    end;
  1809. end; {DLLShiftActiveNode}
  1810.  
  1811. procedure DLLSort(SortID:shortint; Ascending:boolean);
  1812. {Shell sort}
  1813. var
  1814.    I,J,Delta : longint;
  1815.    Swapped : boolean;
  1816.    Ptr1,Ptr2 : DoubleNodePtr;
  1817. begin
  1818.    if (LinkVars.ActiveDLL <> nil)
  1819.    and (LinkVars.ActiveDLL^.TotalNodes >= 2) then with LinkVars.ActiveDLL^ do
  1820.    begin
  1821.       Delta := TotalNodes div 2;
  1822.       repeat
  1823.          repeat
  1824.             Swapped := false;
  1825.             Ptr1 := StartNodePtr;
  1826.             Ptr2 := Ptr1;
  1827.             for I := 1 to Delta do
  1828.               Ptr2 := Ptr2^.NextPtr;
  1829.             for I := 1 to TotalNodes - Delta do
  1830.             begin
  1831.               if I > 1 then
  1832.               begin
  1833.                  Ptr1 := Ptr1^.NextPtr;
  1834.                  Ptr2 := Ptr2^.NextPtr;
  1835.               end;
  1836.               if WrongOrder(SortID,Ptr1,Ptr2,Ascending) then
  1837.               begin
  1838.                  DLLSwapNodes(Ptr1,Ptr2);
  1839.                  Swapped := true;
  1840.               end;
  1841.             end;
  1842.          Until (not Swapped);
  1843.          Delta := Delta div 2;
  1844.       Until Delta = 0;
  1845.    end;
  1846. end; {DLLSort}
  1847.  
  1848. function DLLGetNodeStr(Node:DoubleNodePtr;Start,Finish: longint): string;
  1849. {}
  1850. begin
  1851.    if Node = nil then
  1852.       DLLGetNodeStr := ''
  1853.    else
  1854.      DLLGetNodeStr := LinkVars.ActiveDLL^.GetStr(Node,Start,Finish);
  1855. end; {DLLGetNodeStr}
  1856.  
  1857. function DLLGetStr(Num:longint): string;
  1858. {}
  1859. var DNP: DoubleNodePtr;
  1860. begin
  1861.    DNP := DLLNodePtr(Num);
  1862.    if DNP <> nil then
  1863.       DLLGetStr := LinkVars.ActiveDLL^.GetStr(DNP,0,0)
  1864.    else
  1865.       DLLGetStr := '';
  1866. end; {DLLGetStr}
  1867.  
  1868. procedure DLLSetBit(Node:DoubleNodePtr; BitPos:byte; On:boolean);
  1869. {}
  1870. begin
  1871.    if Node <> nil then
  1872.    begin
  1873.       SetBitStatus(Node^.Bits,BitPos,On);
  1874.       LinkVars.ActiveDLL^.Dirty := true;
  1875.    end;
  1876. end; { DLLSetBit }
  1877.  
  1878. function DLLGetBit(Node:DoubleNodePtr; BitPos:byte): boolean;
  1879. {}
  1880. begin
  1881.    if Node <> nil then
  1882.       DLLGetBit := GetBitStatus(Node^.Bits,BitPos)
  1883.    else
  1884.       DLLGetBit := false;
  1885. end; { DLLGetBit }
  1886.  
  1887. function DLLGetTagState(Num:longint):boolean;
  1888. {}
  1889. var DNP: DoubleNodePtr;
  1890. begin
  1891.    DNP := DLLNodePtr(Num);
  1892.    if DNP <> nil then
  1893.       DLLGetTagState := DLLGetBit(DNP,TagBit)
  1894.    else
  1895.       DLLGetTagState := false;
  1896. end; {DLLGetTagState}
  1897.  
  1898. procedure DLLDestroy;
  1899. {removes all the memory allocated on the heap by chaining back
  1900.  through the list and disposing of each node.}
  1901. var TempPtr: DoubleNodePtr;
  1902. begin
  1903.    if LinkVars.ActiveDLL <> nil then
  1904.    begin
  1905.       TempPtr := LinkVars.ActiveDLL^.EndNodePtr;
  1906.       if TempPtr <> nil then with LinkVars.ActiveDLL^ do
  1907.       begin
  1908.          while TempPtr^.PrevPtr <> nil do
  1909.          begin
  1910.             DLLFreeNodeData(TempPtr);
  1911.             TempPtr := TempPtr^.PrevPtr;
  1912.             freemem(TempPtr^.NextPtr,sizeof(TempPtr^));
  1913.          end;
  1914.          if StartNodePtr <> nil then
  1915.          begin
  1916.             DLLFreeNodeData(StartNodePtr);
  1917.             freemem(StartNodePtr,sizeof(StartNodePtr^));
  1918.             StartNodePtr := nil;
  1919.          end;
  1920.          EndNodePtr := nil;
  1921.          ActiveNodePtr := nil;
  1922.          TotalNodes := 0;
  1923.          ActiveNodeNumber := 0;
  1924.       end;
  1925.    end;
  1926. end; {DLLDestroy}
  1927.  
  1928. function DLLLoadFromFile(Filename:string):integer;
  1929. {Opens a file as text, reads in each line as a node, then closes the file
  1930.     Return codes:   0  all is well!
  1931.                     1  file not found
  1932.                     2  Error Reading file
  1933.                     3  Error creating list
  1934.                     99 No list active
  1935. }
  1936. var
  1937.   F: text;
  1938.   TempStr:string;
  1939. begin
  1940.    if LinkVars.ActiveDLL = nil then
  1941.    begin
  1942.       DLLLoadFromFile := 99;
  1943.       exit;
  1944.    end;
  1945.    assign(F, Filename);
  1946.    {$I-}
  1947.    reset(F);
  1948.    {$I+}
  1949.    if IOResult <> 0 then
  1950.       DLLLoadFromFile := 1
  1951.    else
  1952.    begin
  1953.       DLLDestroy;                     {empty the list}
  1954.       while not eof(F) do
  1955.       begin
  1956.          {$I-}
  1957.          readln(F,TempStr);
  1958.          {$I+}
  1959.          if IOResult <> 0 then
  1960.          begin
  1961.             close(F);
  1962.             DLLLoadFromFile := 2;
  1963.             exit;
  1964.          end;
  1965.          if DLLAddStr(TempStr) <> 0 then
  1966.          begin
  1967.             close(F);
  1968.             DLLLoadFromFile := 3;
  1969.             exit;
  1970.          end;
  1971.       end;
  1972.       close(F);
  1973.       DLLLoadFromFile := 0;
  1974.    end;
  1975. end; {DLLLoadFromFile}
  1976.  
  1977. function DLLSaveToFile(Filename:string):integer;
  1978. {Rewrites the file (erasing its contents) then saves the file SLL data
  1979. as strings in a text file
  1980.     Return codes:   0  all is well!
  1981.                     1  Unable to open file
  1982.                     2  Error Writing file
  1983. }
  1984. var
  1985.   F: text;
  1986.   TempStr:string;
  1987.   Temp1,Temp2: DoubleNodePtr;
  1988. begin
  1989.    assign(F, Filename);
  1990.    {$I-}
  1991.    rewrite(F);
  1992.    {$I+}
  1993.    if IOResult <> 0 then
  1994.       DLLSaveToFile := 1
  1995.    else
  1996.    begin
  1997.       Temp1 := LinkVars.ActiveDLL^.StartNodePtr;
  1998.       while Temp1 <> nil do
  1999.       begin
  2000.          Temp2 := Temp1^.NextPtr;
  2001.          {$I-}
  2002.          writeln(F,DLLGetNodeStr(Temp1,1,255));
  2003.          {$I+}
  2004.          if IOResult <> 0 then
  2005.          begin
  2006.             close(F);
  2007.             DLLSaveToFile := 2;
  2008.             exit;
  2009.          end;
  2010.          Temp1 := Temp2;
  2011.       end;
  2012.       close(F);
  2013.       DLLSaveToFile := 0
  2014.    end;
  2015. end; {DLLSaveToFile}
  2016.  
  2017. procedure DLLEmptyList;
  2018. {}
  2019. begin
  2020.    DLLDestroy;
  2021. end; {DLLEmptyList}
  2022.  
  2023. {|||||||||||||||||||||||||||||||||||||||||||||||||||||}
  2024. {                                                     }
  2025. {       U N I T     I N I T I A L I Z A T I O N       }
  2026. {                                                     }
  2027. {|||||||||||||||||||||||||||||||||||||||||||||||||||||}
  2028. procedure LinkDefaultSettings;
  2029. {}
  2030. begin
  2031.    with LinkVars do
  2032.    begin
  2033.       NoFilesFound := 'No Files';
  2034.       NoDirectories := 'Empty';
  2035.    end;
  2036. end; { LinkDefaultSettings }
  2037.  
  2038. procedure GoldLinkInit;
  2039. {}
  2040. begin
  2041.    with LinkVars do
  2042.    begin
  2043.       ActiveDLL := nil;
  2044.       ActiveSLL := nil;
  2045.       LastActiveDLL := nil;
  2046.       LastActiveSLL := nil;
  2047.       LastECode := 0;
  2048.    end;
  2049.    LinkDefaultSettings;
  2050. end; {GoldLinkInit}
  2051.  
  2052. begin
  2053.    GoldLinkInit;
  2054. end.
  2055.